Animation

Anfangsbedingungen

Die folgenden 3 Anfangswerte können mit beliebig, realistischen Werten ersetzt werden. 
Nach einer Änderung einfach auf “Evaluation” -> “Evaluate Notebook” klicken.

θStart=0.1;
ωStart=120;
μReibung=0.5;

Bewegungsgleichungen

Die detailierte Herleitung und Lösung der folgenden Gleichungen 
befindet sich im File “A.3 Theorie der rotierenden, exzentrischen Kugel”

Lagrangegleichungen

conditions={g->9.81,R->0.02,a->0.000020958656023587824,c->0.000018836151792883442,m->0.13387373494497307,ϵ->0.003618585732165206};

Lagrange[μ]={m (x''[t]+μ (x'[t]+(-R+ϵ Cos[θ[t]]) Sin[φ[t]] θ'[t]+Cos[φ[t]] Sin[θ[t]] (ϵ φ'[t]+R ψ'[t])) (g+ϵ Cos[θ[t]] ((θ'[t])^2)+ϵ Sin[θ[t]] θ''[t]))==0,m (y''[t]+μ (y'[t]+(R-ϵ Cos[θ[t]]) Cos[φ[t]] θ'[t]+Sin[θ[t]] Sin[φ[t]] (ϵ φ'[t]+R ψ'[t])) (g+ϵ Cos[θ[t]] ((θ'[t])^2)+ϵ Sin[θ[t]] θ''[t]))==0,g m ϵ Sin[θ[t]]+m μ (-R+ϵ Cos[θ[t]]) Sin[φ[t]] x'[t] (g+ϵ Cos[θ[t]] ((θ'[t])^2)+ϵ Sin[θ[t]] θ''[t])+m μ (R-ϵ Cos[θ[t]]) Cos[φ[t]] y'[t] (g+ϵ Cos[θ[t]] ((θ'[t])^2)+ϵ Sin[θ[t]] θ''[t])+(1/2) (m (ϵ^2) Sin[2 θ[t]] ((θ'[t])^2)+2 m ϵ μ Cos[θ[t]] (((R-ϵ Cos[θ[t]]))^2) ((θ'[t])^3)+(-a+c) Sin[2 θ[t]] ((φ'[t])^2)+2 c Sin[θ[t]] φ'[t] ψ'[t]+(2 a+m (ϵ^2)-m (ϵ^2) Cos[2 θ[t]]) θ''[t]+2 m μ (((R-ϵ Cos[θ[t]]))^2) θ'[t] (g+ϵ Sin[θ[t]] θ''[t]))==0,g m (ϵ^2) μ ((Sin[θ[t]])^2) φ'[t]+a ((Cos[ψ[t]])^2) Sin[2 θ[t]] θ'[t] φ'[t]+a Sin[2 θ[t]] ((Sin[ψ[t]])^2) θ'[t] φ'[t]+m (ϵ^3) μ Cos[θ[t]] ((Sin[θ[t]])^2) ((θ'[t])^2) φ'[t]+g m R ϵ μ ((Sin[θ[t]])^2) ψ'[t]+m R (ϵ^2) μ Cos[θ[t]] ((Sin[θ[t]])^2) ((θ'[t])^2) ψ'[t]+m (ϵ^3) μ ((Sin[θ[t]])^3) φ'[t] θ''[t]+m R (ϵ^2) μ ((Sin[θ[t]])^3) ψ'[t] θ''[t]+m ϵ μ Cos[φ[t]] Sin[θ[t]] x'[t] (g+ϵ Cos[θ[t]] ((θ'[t])^2)+ϵ Sin[θ[t]] θ''[t])+m ϵ μ Sin[θ[t]] Sin[φ[t]] y'[t] (g+ϵ Cos[θ[t]] ((θ'[t])^2)+ϵ Sin[θ[t]] θ''[t])+c ((Cos[θ[t]])^2) φ''[t]+a ((Cos[ψ[t]])^2) ((Sin[θ[t]])^2) φ''[t]+a ((Sin[θ[t]])^2) ((Sin[ψ[t]])^2) φ''[t]+c Cos[θ[t]] ψ''[t]==c Sin[θ[t]] θ'[t] (2 Cos[θ[t]] φ'[t]+ψ'[t]),m R μ Sin[θ[t]] (Cos[φ[t]] x'[t]+Sin[φ[t]] y'[t]+Sin[θ[t]] (ϵ φ'[t]+R ψ'[t])) (g+ϵ Cos[θ[t]] ((θ'[t])^2)+ϵ Sin[θ[t]] θ''[t])+c (-Sin[θ[t]] θ'[t] φ'[t]+Cos[θ[t]] φ''[t]+ψ''[t])==0};

Lösung

tmax=10;
Lagrange[μ_]=Lagrange[μ]/.conditions;
sol[μ_,ω0_,θ0_]:=NDSolve[{Lagrange[μ]/.conditions,x[0]==0,  x'[0]==0,y[0]==0,  y'[0]==0,θ[0]==θ0,θ'[0]==0,φ[0]==0,  φ'[0]==0,ψ[0]==0,  ψ'[0]==ω0},{x[t],y[t],θ[t],φ[t],ψ[t]},{t,0,tmax},Method->{"EquationSimplification"->"Residual"}];

Animation

Allgemein

Das Kugel-Modell

image=;

ground={LightGray,Polygon[{{1.5 R,-1.5 R,-1 R},{1.5 R,1.5 R,-1 R},{-1.5 R,1.5 R,-1 R},{-1.5 R,-1.5 R,-1 R}}]}/.conditions;

Kugel=SphericalPlot3D[ {0.02}, {θ,0,Pi},{φ,0,2Pi},Mesh->None,Axes->None,PlotRange->All,Lighting->"Neutral",TextureCoordinateFunction->({#1,#3}&),PlotStyle->Texture[image],Boxed->False]/.conditions;

viewpoint={0,-2,1 };

EulerGT=(({{-Cos[φ] Cos[ψ]+Cos[θ] Sin[φ] Sin[ψ], +Cos[θ] Cos[ψ] Sin[φ]+Cos[φ] Sin[ψ], -Sin[θ] Sin[φ]}, {-Cos[ψ] Sin[φ]-Cos[θ] Cos[φ] Sin[ψ], -Cos[θ] Cos[φ] Cos[ψ]+Sin[φ] Sin[ψ], +Cos[φ] Sin[θ]}, {-Sin[θ] Sin[ψ], -Cos[ψ] Sin[θ], -Cos[θ]}}));

θsol[t_]=θ[t]/.sol[μReibung,ωStart,θStart][[1]];
ψsol[t_]=ψ[t]/.sol[μReibung,ωStart,θStart][[1]];
φsol[t_]=φ[t]/.sol[μReibung,ωStart,θStart][[1]];
xsol[t_]=x[t]/.sol[μReibung,ωStart,θStart][[1]];
ysol[t_]=y[t]/.sol[μReibung,ωStart,θStart][[1]];

xmax=If[FindMaximum[{xsol[t],0≤ t≤ tmax},{t,tmax/2}][[1]]<2 R,2 R,FindMaximum[{xsol[t],0≤ t≤ tmax},{t,tmax/2}][[1]]+2R]/.conditions;
xmin=(FindMinimum[{xsol[t],0≤ t≤ tmax},{t,tmax/2}][[1]]-2R)/.conditions;
ymax=(FindMaximum[{ysol[t],0≤ t≤ tmax},{t,tmax/2}][[1]]+2R);
ymin=(FindMinimum[{ysol[t],0≤ t≤ tmax},{t,tmax/2}][[1]]-2R);

Exzentrische Kugel

Rotation

sphereSol[φ_,θ_,ψ_]=Graphics3D[{GeometricTransformation[Kugel[[1]],EulerGT],ground},Boxed->False,ViewPoint->viewpoint,SphericalRegion->True,PlotRange->{{-2 R,2 R},{-2 R,2 R},{-2 R,2 R}},ImageSize->Large]/.conditions;


Manipulate[

sphereSol[φsol[t],θsol[t],ψsol[t]]

,Style["Rotation der exzentrischen Kugel","Title",18,Bold]
,{t,0,tmax,AnimationRate->0.05, ControlType -> Animator,AnimationRunning->False}]

Rotation und Translation

groundTrans={LightGray,Polygon[{{xmax,ymin,-1 R},{xmax,ymax,-1 R},{1.1 xmin, ymax,-1 R},{ xmin,ymin,-1 R}}]}/.conditions;

pfad[tak_]:=ParametricPlot3D[{xsol[t],ysol[t],0},{t,0,tak+0.001},Boxed->False,Axes->False,ImageSize->Medium,PlotStyle->{Darker[Green],Dashed}]/.conditions;

sphereSolTrans[φ_,θ_,ψ_,x_,y_]=Graphics3D[{Translate[Translate[GeometricTransformation[Kugel[[1]],EulerGT],x{1,0,0}],y{0,1,0}],groundTrans},Boxed->False,ViewPoint->viewpoint,SphericalRegion->True,PlotRange->{{1.1xmin,xmax},{ymin,ymax },{-2 R,2 R}},ImageSize->Large]/.conditions;


Manipulate[
Show[{
sphereSolTrans[φsol[t],θsol[t],ψsol[t],xsol[t],ysol[t]],pfad[t]}]

,Style["Rotation und Translation der exzentrischen Kugel","Title",18,Bold]
,{t,0,tmax-0.001,AnimationRate->0.1, ControlType -> Animator,AnimationRunning->False}]

Stehaufkreisel

Rotation

α=(π/3);
RM=R/.conditions;
Ra=R/5/.conditions;
out=SphericalPlot3D[RM,{θ,α,π},{φ,0,2π},Boxed->False,Axes->False];
in=ParametricPlot3D[ {((Sin[π-α] z)/(-Cos[π-α])) Cos[ϕ],((Sin[π-α] z)/(-Cos[π-α]))Sin[ϕ], z}, {ϕ, -π, π}, {z, 0, -RM Cos[π-α]},PlotRange->All,Boxed->False,Axes->False];
axle={{Sphere[{0,0,RM-Ra},Ra],Cylinder[{{0,0,0},{0,0,RM-Ra}},Ra]}};
TippeTop={{in[[1]],out[[1]],axle}};

TippeTopRot[φ_,θ_,ψ_]=Graphics3D[{GeometricTransformation[Rotate[TippeTop,π,{1,0,0}],EulerGT],ground},Boxed->False,ViewPoint->viewpoint,SphericalRegion->True,PlotRange->{{-2 R,2 R},{-2 R,2 R},{-2 R,2 R}},ImageSize->Large]/.conditions;

Manipulate[

TippeTopRot[φsol[t],θsol[t],ψsol[t]]

,Style["Rotation der exzentrischen Kugel","Title",18,Bold]
,{t,0,tmax,AnimationRate->0.05, ControlType -> Animator,AnimationRunning->False}]

Rotation und Translation

TippeTopTrans[φ_,θ_,ψ_,x_,y_]=Graphics3D[{Translate[Translate[GeometricTransformation[Rotate[TippeTop,π,{1,0,0}],EulerGT],x{1,0,0}],y{0,1,0}],groundTrans},Boxed->False,ViewPoint->viewpoint,SphericalRegion->True,PlotRange->{{1.1xmin,xmax},{ymin,ymax },{-2 R,2 R}},ImageSize->Large]/.conditions;

Manipulate[
Show[{
TippeTopTrans[φsol[t],θsol[t],ψsol[t],xsol[t],ysol[t]],pfad[t]}]

,Style["Rotation und Translation des Stehaufkreisels","Title",18,Bold]
,{t,0,tmax-0.001,AnimationRate->0.1, ControlType -> Animator,AnimationRunning->False}]